home *** CD-ROM | disk | FTP | other *** search
/ The Utilities Experience / The Utilities Experience - Volume 1.iso / software / comms / thor_2.22 / thor.lha / rexx / GetEMail.thor < prev    next >
Text File  |  1995-12-18  |  5KB  |  184 lines
  1. /*
  2.  $VER: GetEmail.Thor 1.4 by Remco van Hooff
  3.  
  4.  Rips email addresses out of the current message, and
  5.  optionaly saves them to the userlist of your Email system.
  6.  
  7. ------------------------- HISTORY -------------------------
  8. 1.0 - First release
  9. 1.1 - Some little cosmetic fixes
  10. 1.2 - Fixed a parsing bug, now addresses at the beginning
  11.       of a line are parsed ok.
  12. 1.3 - Added checking if there is more than one address on
  13.       one a line, so all addresses should be found now.
  14. 1.4 - Ajusted the script with the new Thor 2.1 arexx
  15.       commands. No more RexxReqTools.library needed. 
  16. ------------------------- CREDITS -------------------------
  17. Jon Ward, for the idea.
  18. -----------------------------------------------------------
  19. */
  20.  
  21. bbs       = 'Email'        /* your Email system */
  22.  
  23. if ~show('l','rexxsuppport.library') then call addlib('rexxsupport.library',0,-30,0)
  24.  
  25. drop USER.
  26. tempfile  = 't:email.tmp'
  27.  
  28. options failat 31
  29. p = address() || ' ' || show('P',,)
  30. thorport = pos('THOR.',p)
  31. if thorport > 0 then thorport = word(substr(p,thorport),1)
  32. else do
  33.   say 'THOR port not found!'
  34.   exit 10
  35. end
  36.  
  37. if ~show('p', 'BBSREAD') then do
  38.   address command
  39.     "run >nil: `GetEnv THOR/THORPath`bin/LoadBBSRead"
  40.     "WaitForPort BBSREAD"
  41. end
  42.  
  43. address(thorport)
  44. options results
  45.  
  46. saved = 0
  47. SAVEMESSAGE CURRENT FILENAME tempfile NOHEADER NOANSI OVERWRITE
  48. if(rc ~= 0) then do
  49.   'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_Ok"'
  50.   exit
  51. end
  52.  
  53. else do
  54.   call open(tmp,tempfile,'r')
  55.   msg = readch(tmp,102400)
  56.   check = pos('@', msg)
  57.     if check = 0 then do
  58.       'requestnotify text "No Email address found." bt "_OK"'
  59.       signal abort
  60.     end
  61.   call close(tmp)  
  62.   if check ~= 0 then do
  63.     call open(tmp, tempfile, 'r')
  64.       do while ~eof(tmp)
  65.         msg = readln(tmp)
  66.         parse var msg part1 '@' part2 '.' part3 rest
  67.         do forever
  68.           if part2 ~= '' then do
  69.             spc = lastpos(' ', part1)
  70.             if spc ~= 0 then part1 = delstr(part1, 1, spc)
  71.             lengte = length(part3)   
  72.             call filter(part3, lengte)
  73.             vraag = 'Add this Email address to\nthe' bbs 'userdatabase?'
  74.             ttl = 'the' bbs 'userdatabase?'
  75.             if ((lengte2 > length(bbs)+18) & (lengte2 > 26)) then vraag = center('Add this Email address to',lengte2,' ')||'\n'||center(ttl,lengte2,' ')
  76.             /* remember that filling up with spaces only works correct if you use a non proportional font */
  77.             REQUESTSTRING title '"GetEmail"' body '"'vraag'"' BT '"_Add|_Quit|S_kip"' ID '"'email'"'
  78.             email = result 
  79.             if thorrc = 1 then do
  80.               call ask
  81.             end
  82.             if thorrc = 2 then do
  83.               signal abort
  84.             end
  85.           end
  86.           if pos('@', rest) ~= 0 then do
  87.             parse var rest part1 '@' part2 '.' part3 rest
  88.             empty = 0
  89.           end 
  90.           else empty = 1
  91.           if empty = 1 then leave
  92.         end
  93.       end
  94.     call close(tmp)
  95.   end
  96.   call delete(tempfile)
  97.   'requestnotify text "No more Email addresses found." bt "_OK"'
  98. end
  99. exit
  100.  
  101. ask:
  102.   address(thorport)
  103.   do forever
  104.     REQUESTSTRING title '"GetEmail"' BT '"_Ok|_Cancel"' body '"Enter owner of the address\n'email'."' ID '"'part1'"'
  105.     if rc=30 then do
  106.     REQUESTNOTIFY '"'THOR.LASTERROR'"' '"_Ok"'
  107.     call abort
  108.     end
  109.     username = result
  110.     if rc = 0  then leave
  111.   end
  112.  
  113.   'REQUESTSTRING title "GetEmail" body "Enter an alias for\n'username':" BT "_Ok|_Cancel" MAXCHARS=100'
  114.    if rc = 0 then useralias = result
  115.    if rc = 5 then useralias = ''
  116.   'REQUESTSTRING title "GetEmail" body "Enter a comment:" BT "_Ok|_Cancel" MAXCHARS=100'
  117.   if rc = 0 then usercomment = result
  118.   if rc = 5 then usercomment = ''
  119.   'REQUESTNOTIFY "Name : 'username'\nAddr : 'email'\nAlias: 'useralias'\nComnt: 'usercomment'\n\nAdd this user to system' bbs'?"' '"_Yes|_No"'
  120.   if rc~=0 then do
  121.     REQUESTNOTIFY '"THOR.LASTERROR"' '"_Ok"'
  122.     call abort
  123.   end
  124.   if result ~= 0 then do
  125.     address BBSREAD
  126.     USER.NAME      = username
  127.     USER.ADDRESS   = email
  128.     USER.ALIAS     = useralias
  129.     USER.COMMENT.1 = usercomment
  130.     if USER.COMMENT.1 = '' then USER.COMMENT.COUNT = 0; else USER.COMMENT.COUNT = 1
  131.  
  132.     WRITEBRUSER bbsname '"'bbs'"' stem USER ONLYIFEXIST
  133.     if rc~=0 then do
  134.       address(thorport)
  135.       REQUESTNOTIFY '"'BBSREAD.LASTERROR'"' '"_Ok"'
  136.       call abort
  137.     end
  138. end
  139. return
  140.  
  141. filter:
  142.   adres = arg(1)
  143.   lngth = arg(2)
  144.   lf    = '0a'x
  145.  
  146.   lnfd = pos(lf, adres)
  147.   if lnfd ~=0 then do
  148.     adres = delstr(adres, lnfd)
  149.   end
  150.  
  151.   haak = lastpos(')', adres)
  152.   if haak ~=0 then do
  153.     adres =  delstr(adres, haak)
  154.   end
  155.  
  156.   hook = lastpos('>', adres)
  157.   if hook ~=0 then do
  158.     adres =  delstr(adres, hook)
  159.   end
  160.  
  161.   komma = pos(',', adres)
  162.   if komma ~= 0 then do
  163.     adres = delstr(adres, komma)
  164.   end
  165.   
  166.   quote = pos("'", adres)
  167.   if quote ~= 0 then do
  168.     adres = delstr(adres, quote)
  169.   end
  170.  
  171.   dquote = pos('"', adres)
  172.   if dquote ~= 0 then do
  173.     adres = delstr(adres, dquote)
  174.   end
  175.  
  176.   email = part1'@'part2'.'adres
  177.   lengte2 = length(email)
  178. return
  179.  
  180. abort:
  181.   call close(tmp)
  182.   call delete(tempfile)
  183. exit
  184.